home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / TEXTFILE.SWG / 0032_Parse file by words.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  2KB  |  93 lines
  1.  
  2. program ReadWord;
  3. uses dos,crt;
  4. Const
  5.   delimiters = ' ,./?;:"[]{}!';
  6.   CrLf       = #13#10;
  7. type
  8.   tfilename = string;
  9.   word_type = string;
  10.   wp_type   = ^word_type;
  11.  
  12. var
  13.   i          : word;
  14.   filter     : string;
  15.   sr         : searchrec;
  16.   path       : pathstr;
  17.   dir        : dirstr;
  18.   fname      : namestr;
  19.   ext        : extstr;
  20.   Lines       : word;
  21.  
  22.  
  23. procedure ShowSyntax;
  24. begin
  25.   writeln('USAGE       OBJDIC     <input fileset>                         ');
  26.   writeln('                                                               ');
  27.   writeln('       <input fileset> is a DOS filename (wildcards allowed)   ');
  28.   writeln('                                                               ');
  29.   writeln('                                                               ');
  30.   writeln('Example    OBJDIC *.TXT                                        ');
  31.   halt;
  32. end;
  33.  
  34.  
  35. function GetNextWord (buf:string; apos:byte; var aword:word_type; var delim:string) : byte;
  36. var i,j,ch: byte;
  37. begin
  38.   i := apos;
  39.   while (i <= length(buf)) and (pos(buf[i],delimiters) = 0) do inc (i);
  40.   aword := copy(buf,apos, i - apos);
  41.   j:= i;
  42.   while (i <= length(buf)) and
  43.        ( ( (upcase(buf[i]) < 'A') or (upcase(buf[i]) > 'Z') ) and
  44.          ( (buf[i] <  '0'       ) or (buf[i] > '9'        ) ) )
  45.         do inc(i);
  46.   delim := copy(buf,j,i-j);
  47.   if i = length(buf) then i := 0;
  48.   GetNextWord :=i;
  49. end;
  50.  
  51.  
  52.  
  53. procedure scanfile(filename : string);
  54. var
  55.   infile : text;
  56.   inbuf  : string;
  57.   aword  : word_type;
  58.   adelim : word_type;
  59.   len    : byte;
  60.   inpos  : byte;
  61.   index  : word;
  62.  
  63. begin
  64.   path := fexpand(filename);
  65.   fsplit(path,dir,fname,ext);
  66.   assign(infile,path);
  67.   reset(infile);
  68.   clrscr;
  69.   lines:=0;
  70.   writeln('Scanning ',filename);
  71.   while not eof(infile) do begin
  72.      readln(infile,inbuf); inc(lines);
  73.      inpos := 1;
  74.      while (inpos < length(inbuf)) and (inpos <> 0) do begin
  75.        inpos := GetNextWord(inbuf,inpos,aword,adelim);
  76.        if length(aword) > 0 then write(aword);
  77.        if length(adelim) > 0 then write(adelim);
  78.      end;
  79.      writeln;
  80.    end;
  81.    close(infile);
  82.    writeln;
  83.  end;
  84.  
  85.  begin
  86.    filter := Paramstr(1);
  87.    FindFirst(Filter,AnyFile,sr);
  88.    while DosError = 0 do with sr do begin
  89.       scanfile(fexpand(name));
  90.       FindNext(sr);
  91.    end;
  92.  end.
  93.